COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGOF("QUADS")
C00003 00003	PUBLIC SIMPLE PROCEDURE QUADS! $"#
C00004 00004	PUBLIC RECURSIVE PROCEDURE BOUND(INTEGER KIND) $"#
C00011 00005	PUBLIC SIMPLE PROCEDURE DINDENT $"#
C00012 00006	PUBLIC SIMPLE PROCEDURE DSUPERIMPOSE $"#
C00013 00007	PUBLIC SIMPLE PROCEDURE DTABS $"#
C00015 00008	PUBLIC SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) $"#
C00017 00009	PUBLIC RECURSIVE PROCEDURE TABTO(INTEGER POSNO) $"#
C00018 00010	PUBLIC SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) $"#
C00021 00011	FINISHED
C00022 ENDMK
C⊗;
BEGOF("QUADS")


COMMENT

Tabs, somescripts, infinity, superimpose, flush left, flush right,
and center.  Also the INDENT declaration.

;


PROCEDURES
PUBLIC SIMPLE PROCEDURE QUADS! ;$"#
BEGIN "QUADS!"
TABSORT[1]←TWO(33);
END "QUADS!" ;
PUBLIC RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;$"#
PLK: THIS ENTIRE PROCEDURE REWORKED 6-FEB-75
	THE INFORMATION PASSED TO PASS2 FOR ∞ STRINGS AND → AND ← IS
	(1)	WHERE WE WANT TO BE
	(2)	WHERE WE ARE
	(3)	1 OR 2 ( WE LIED IN THE FIRST CASE IF IT WAS CENTERING)
	(4)	XLENGTH OF THE ∞ STRING (ONLY IN XCRIBL MODE)
	(5)	THE ∞ STRING
	;
IF ON THEN
BEGIN "BOUND"
STRING FILLER,SEGMENT,BOUNDS;

	SIMPLE PROCEDURE TABCASE(INTEGER RB);
	BEGIN "TABCASE"
	INTEGER LB;
	RB←RB*CHARW;
	LB←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW - (LBFAKE-OLBFAKE);
	BOUNDS ← CVSR(RB) & CVSR(LB) & CVSR(1);
	SEGMENT←NULL;
	FILLER ← LBF;
	APPEND(FONTCHAR & "→") ; APPEND (BOUNDS);
	IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
	APPEND(FILLER & ALTMODE);
	APPEND(FONTCHAR & "←");
	END "TABCASE";

COMMENT
	KIND	≤  0 ... ∞X	(THE ASCII OF X NEGATED)
		= 1 ... ←
		= 2 ... →
		= 3 ... CR OR BREAK
		= 4 ... TAB (\ OR ∂) ;
IF KIND=3 OR (KIND=4 AND NULSTR(LBF)) THEN
	SPCS←0
    ELSE EMIT(NULL);
OKCR(TRUE) ; COMMENT ADDED 4/17/72 ;

COMMENT AN EARLIER BOUND ON THIS LINE MAY HAVE SET LBK←KIND ;
IF LBK < 3 THEN
  CASE (LBK MAX 0) OF
    BEGIN "BY KIND"
[0]   COMMENT ∞ ONLY VALID IF IMMEDIATELY PRECEDING THIS BOUND ;
	IF (LBO < OAKS) OR (SPCS>0) THEN
		BEGIN "SHOULD NOT HAVE MOVED"
		WARN("=","∞ NEEDS A RIGHT BOUND") ;
		LBF ← NULL ;
		END ;
[1]   COMMENT CENTER BETWEEN LEFT BOUND AT POSN=LBP AND THIS TAB TO RBOUND, OR BETWEEN MARGINS ;
	BEGIN "CENTER"
	INTEGER LB,RB,FAKEL,MINL,LASTPOSN;
	FAKEL←FAKE-LBFAKE;
	LASTPOSN←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW;
	MINL←(IF XCRIBL THEN (XPOSN-XLBP) ELSE (POSN-LBP))-FAKEL;
	RB ← (IF KIND=4 THEN ((RBOUND+LMARG)*CHARW+LASTPOSN) ELSE ((RMARG+LMARG)*CHARW)) - MINL;
	LB ← LASTPOSN - (LBFAKE-OLBFAKE);
	BOUNDS←CVSR(RB) & CVSR(LB) & CVSR(2);	PLK: MUST DIVIDE BY 2 IN PASS2
						TO PREVENT TRUCATION FROM HAPPENING TWICE;
	SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
	APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
	IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
	APPEND(FILLER & ALTMODE);
	APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
	POSN ← ((RB DIV CHARW) + FAKEL) DIV 2 + MINL;
	XPOSN ← (RB + FAKEL) DIV 2 + MINL;
	LBFAKE←LBFAKE + ((FAKEL-1) DIV 2);	plk: so that OLBFAKE will be right the next time
						     in the event of an ∞ string;
	END "CENTER" ;
[2]   COMMENT → RIGHT FLUSH AGAINST TAB TO RBOUND OR AGAINST RIGHT MARGIN ;
	BEGIN "RIGHT FLUSH"
	INTEGER RB,LB;
	RB ← (IF KIND=4 THEN (RBOUND+LMARG)*CHARW ELSE RMARG*CHARW) -
		(IF XCRIBL THEN (XPOSN-XLBP) ELSE (POSN-LBP)) +
		(FAKE-LBFAKE);
	LB←(IF XCRIBL THEN XLBP ELSE LBP) + LMARG*CHARW - (LBFAKE-OLBFAKE);
	BOUNDS←CVSR(RB) & CVSR(LB) & CVSR(1);
	SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
	APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
	IF XCRIBL THEN APPEND(CVSR(XLENGTH(FILLER)));
	APPEND(FILLER & ALTMODE);
	APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
	POSN ← RB DIV CHARW;
	XPOSN ← RB;
	END "RIGHT FLUSH" 
    END "BY KIND";
IF KIND=3 AND FULSTR(LBF) THEN TABCASE(RMARG);
IF  KIND=4 THEN
	BEGIN "TAB"
	IF FULSTR(LBF) THEN TABCASE(RBOUND+LMARG)
	    ELSE APPEND(FONTCHAR&"="&CVSR(CHARW*(RBOUND+LMARG)));
	BRKXPOSN←BRKXPOSN+FSHORT;  FSHORT←0;
	POSN ← RBOUND ;	XPOSN ← RBOUND * CHARW ;
	END "TAB" ;
IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
	ELSE IF FILL THEN MAXIM ← IF KIND LEQ 2 THEN NMAXIM ELSE FMAXIM ;
IF KIND = 3 THEN XLBP ← LBP ← LBO ← LBFAKE ← OLBFAKE ← 0	RKJ: 1-22-74;
    ELSE
	BEGIN "SETUP FOR NEXT TIME"
				COMMENT FINALLY, SET LEFT BOUND FOR A SUBSEQUENT BOUND ;
	LBO ← OAKS ;  LBP ← POSN ; XLBP ← XPOSN ;
	LBK ← KIND ; MIDWORD ← FALSE ;
	IF KIND LEQ 0 THEN
		BEGIN LBF←LBF&(-KIND); RETURN END;	plk: cannot reset the LBxx if we
							are only making the ∞ string longer;
	OLBFAKE ← LBFAKE ; LBFAKE ← FAKE ;
					plk: (leq 0) and 3 have been eliminated by now;
	IF KIND=4 THEN OLBF←LBF←NULL
	    ELSE BEGIN OLBF←LBF; LBF←NULL; END;
	END "SETUP FOR NEXT TIME";
END "BOUND" ;
PUBLIC SIMPLE PROCEDURE DINDENT ;$"#
BEGIN
STRING X ;
DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON AND FULSTR(X) THEN FIRSTIM ← CVD(X) ;
IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON AND FULSTR(X) THEN RESTIM←CVD(X) ;
IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON AND FULSTR(X) THEN RIGHTIM←CVD(X) ;
END "DINDENT" ;
PUBLIC SIMPLE PROCEDURE DSUPERIMPOSE ;$"#
BEGIN
INTEGER N ;
DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF  NOT ON THEN RETURN ;
TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
END "DSUPERIMPOSE" ;
PUBLIC SIMPLE PROCEDURE DTABS ;$"#
BEGIN TES 8/26/74 REWROTE FOR ASCEND-CHECK AND "ONLY" OPTION ;
INTEGER NUMB, I, BIG ;
BIG ← 0 ;
FOR I ← 1 THRU TABLIMIT DO
	BEGIN
	PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
	IF ON THEN
	IF NUMB LEQ BIG THEN
		BEGIN
		WARN(NULL, <"TAB STOPS " & CVS(BIG) & "," & CVS(NUMB) & " ARE OUT OF ORDER">) ;
		I ← I - 1 ;
		END
	ELSE TABSORT[I] ← BIG ← NUMB ;
	IF NOT ITSCH(<,>) THEN BEGIN I ← I + 1 ; DONE END ;
	END ;
IF ON AND I > TABLIMIT THEN WARN(NULL,"Too many Tab Stops") ;
NUMB ← IF ITS(ONLY) THEN IPASS(TWO(34))	TES 8/26/73 FOR BRIAN HARVEY ;
ELSE TWO(33) ;
IF ON THEN TABSORT[I] ← NUMB ;
END "DTABS" ;
PUBLIC SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;$"#
BEGIN
INTEGER CHR ;
CHR ← LOP(INPUTSTR) ;
HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
ABOVEX ← ABOVEX MAX HEIGHT ;  BELOWX ← BELOWX MIN HEIGHT ;
IF POSN LEQ MAXIM OR XCRIBL THEN 
	BEGIN EMIT(NULL);
	APPEND(FONTCHAR&ARROW); 
	IFC SAILVER THENC COMMENT RHT 5/7/76;
	    IF DSCRIPTM AND XCRIBL THEN APPEND(FONTCHAR&ARROW);
	ENDC
	END ;
RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
	AMPPOSN ← AMPPOSN LSH 9  ; COMMENT 3/28/72 ; END
ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
END "SCRIPT" ;
PUBLIC RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;$"#
IF ON THEN
BEGIN TES 8/14/74 SIMPLIFIED AND FIXED A BUG ;
POSNO ← POSNO MAX 1-LMARG ; TES 8/11/74 ;
IF (IF XCRIBL THEN (POSNO*CHARW LEQ XPOSN) ELSE (POSNO LEQ POSN)) THEN
	IF FULSTR(LBF) THEN
		BEGIN
		WARN("=","Already passed tab column " & CVS(POSNO)) ;
		RETURN ;
		END
	ELSE TABI ← 0
ELSE IF POSNO>NMAXIM+LMARG THEN
	BEGIN
	WARN("BAD TAB",<"Can't TAB past right margin to char "&CVS(POSNO)&
		(IF FILL THEN CRLF&"Did you really mean to be in FILL mode?" ELSE NULL)>) ;
	RETURN
	END ;
RBOUND ← POSNO-1 ;
BOUND(4) ;
END "TABTO" ;
PUBLIC SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;$"#
BEGIN
INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
IFCR SAILVER THENC comment RHT 4/22/76;
	SIMPLE INTEGER PROCEDURE XPADJ(INTEGER I);
		RETURN(IF XCRIBL THEN I*CHARW ELSE I);
ELSEC
	DEFINE XPADJ(I) = [I];
ENDC
IF ARROW = 0 THEN
	BEGIN COMMENT "]" -- find matching "[" ;
	ARROW ← SUPERSUB LAND '177 ;
	AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
	SUPERSUB ← SUPERSUB LSH -9 ;
	END ;
IF POSN LEQ MAXIM OR XCRIBL THEN
	BEGIN
	EMIT(NULL) ;
	IF ARROW NEQ "." THEN
		BEGIN
		APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
		IFC SAILVER THENC COMMENT RHT 5/7/76;
		    IF DSCRIPTM AND XCRIBL THEN APPEND(FONTCHAR&("↑"+"↓"-ARROW));
		ENDC
		HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
		END ;
	END ;
WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
	BEGIN
	LOPP(INPUTSTR) ;
	MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
	AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
	IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(XPADJ(POSN-PN))); POSN←PN END ;
	IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
		BEGIN
		SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
		LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
		END
	ELSE IF CHR NEQ UARROW AND CHR NEQ DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
	END
ELSE MORE ← FALSE ;
IF  NOT MORE THEN BEGIN COMMENT 3/28/72: ;
	PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
	IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(XPADJ(PN-POSN))) ; POSN←PN END END ;
IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
END "UNSCRIPT" ;
FINISHED

ENDOF("QUADS")